perm filename SCAN.FAI[NEW,LCS]12 blob
sn#496797 filedate 1980-02-09 generic text, type T, neo UTF8
00100 TITLE SCANR
00200 ENTRY SCANR,LNEND,STFNUM,RLOOP
00300 EXTERNAL SCN,SC,ALF,NALF,EXP3.2,SCX,SCM,RMOD,JCHAR,A2Z,MKX
00400 ML←5 ↔ K←0 ↔ NNUM←14 ↔ ISKP←13 ↔ JJ←12 ↔ XMINUS←11 ↔ DECI←10
00500 M←7 ↔ N←6 ↔ QQ←4 ↔ TRIP←3
00600 DEFINE LTT<A2Z+=19> ↔ DEFINE LZ<A2Z+=25>
00700 DEFINE LM <A2Z+=12> ↔ DEFINE LN<A2Z+=13> ↔ DEFINE LP <A2Z+=15>
00800 DEFINE LL <A2Z+=11> ↔ DEFINE LR<A2Z+=17> ↔ DEFINE LBL <SCX+=11>
00900 ;; DEFINE LL <SCN> ↔ DEFINE LR<SCN+1> ↔ DEFINE LBL <SCX+=11>
01000 DEFINE LSL <MKX> ↔ DEFINE LST <SCX+=7 > ↔DEFINE LCM<SCX>
01100 ;; DEFINE LSL <SCN+4> ↔ DEFINE LST <SCX+=7 > ↔DEFINE LCM<SCX>
01200 DEFINE LE <A2Z+4> ↔ DEFINE LC <A2Z+2> ↔ DEFINE LS <A2Z+=18>
01300 ;; DEFINE LE <SCN+5> ↔ DEFINE LC <SCN+6> ↔ DEFINE LS <SCN+7>
01400 DEFINE LPL<SCX+=6 > ↔DEFINE LMI<SCX+1> ↔ DEFINE LF <A2Z+5>
01500 ;; DEFINE LPL<SCX+=6 > ↔DEFINE LMI<SCX+1> ↔ DEFINE LF <SCN+=8>
01600 DEFINE LA <A2Z> ↔ DEFINE LI <A2Z+=8> ↔ DEFINE LW <A2Z+=22>
01700 ;; DEFINE LA <SCN+=9> ↔ DEFINE LI <SCN+=10> ↔ DEFINE LW <SCN+=11>
01800 DEFINE JN <SC+=10> ↔ DEFINE DBST <SC+=11> ↔ DEFINE ISEMI <JCHAR+1>
01900 DEFINE IXX <A2Z+=23> ↔ DEFINE MODE <SC+=70> ↔ DEFINE VX <SC+=16>
02000 DEFINE LU <A2Z+=20> ↔ DEFINE LD <A2Z+3> ↔ DEFINE INP <ALF>
02100 ;; DEFINE LU <SCN+2> ↔ DEFINE LD <SCN+3> ↔ DEFINE INP <ALF>
02200 DEFINE REXP<SC+6> ↔DEFINE DOT<SCX+2> ↔ DEFINE VX4 <SC+=19>
02300 ;; DEFINE STAFF<SCM+=80>
02400 IQ: BLOCK 12
02500 ; 00100 C SUBRS. SCANR, NALF, EDIT, PRESCN
02600 ; 00300 C ***** MSS SCANNER *************************
02700 ; 00400 SUBROUTINE SCANR
02800 ; 00500 DIMENSION IQ(10),LRUD(4)
02900 ; 00600 COMMON/ALF/INP(72),ML
03000 ;650 COMMON/SCN/LL,LR,LU,LD,LSL,LE,LC,LS,LF,LA,LI,LW
03100 ; COMMON/SCX/JALPHA(30),J4,L,Y,K,RX,RZ,RA,J5 /JCHAR/IXX,ISEMI,JBLA,IG
03200 ; 00700 COMMON /SC/J,L,MK
03300 ; 00800 1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
03400 ; 00900 1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
03500 ;1000 EQUIVALENCE (IQ(1),VX(41)),(VX1,VX(1)),(VX2,VX(2)),(LDN,LRUD(4))
03600 ; 01100 DATA LRUD/'L','R','U','D'/
03700 ; 01200 C FOR LEFT, RIGHT, UP, DOWN, EDIT
03800 SCANR: 0
03900 MOVE ML,ALF+=72 ; 5 IS ML UNTIL RETURN
04000 SETOM NNUM ;1300 NNUM=-1
04100 SETZM ISKP ;1400 ISKP=0
04200 SETZM JJ ; 01500 JJ=0
04300 MOVSI XMINUS,201400 ; 01600 XMINUS=1.
04400 ; 01700 C LEAVES BLANK WHEN REST.
04500 ; 01800 999 DECI=-1
04600 S999: SETOM DECI ;INTEGER UNTIL S11!
04700 SETZM M ; 01900 M=0
04800 S2799: MOVE N,INP -1(ML) ; 02000 2799 N=INP(ML)
04900 S899: AOS ML ; 02100 899 ML=ML+1
05000 CAMN N,LSL ; 02200 781 IF(N.EQ.'/')N=ISEMI
05100 MOVE N,ISEMI
05200 ;2300 C FOR MOTIVIC TRANFORMATIONS
05300 CAME N,LST ;02380 IF(N.EQ.'*')GO TO 751
05400 CAMN N,ISEMI
05500 JRST S751 ; 02400 IF(N.EQ.ISEMI)GO TO 751
05600 ; 02500 C '*' AND '/' ADDED ABOVE 4/18/73
05700 CAMN N,IXX ; 02600 IF(N.NE.IXX)GO TO 22
05800 SKIPGE SC+=10 ; JN
05900 JRST S22 ; 02650 IF(JN)GO TO 22
06000 JUMPE ISKP,S210 ;02700 IF(ISKP.EQ.0)GO TO 210
06100 SOS ML ; 02800 ML=ML-1
06200 JRST S202 ; 02900 GO TO 202
06300 S22: CAMN N,LBL ;3000 22 IF(N.EQ.IBLA)GO TO 4702
06400 JRST S4702 ; 03050 IF(N.NE.',')GO TO 510
06500 CAME N,LCM
06600 JRST S510
06700 S4702: JUMPGE ISKP,S2799 ;3100 4702 IF(ISKP)202,2799,2799
06800 JRST S202 ; 03200 512 ML=ML+1
06900 S512: MOVE 2,ISEMI
07000 AOS ML ; 03300 IF(INP(ML).EQ.ISEMI)RETURN
07100 CAMN 02,INP -1(ML)
07200 JRST SEND
07300 JRST S512+1 ; 03400 GO TO 512
07400 LRUD: ASCII/L /
07500 ASCII/R /
07600 ASCII/U /
07700 ASCII/D /
07800 S510: MOVE 02,JN ;3600 510 IF(JN.GE.0)GO TO 173
07900 JUMPGE 02,S173
08000 MOVEI 02,1 ;3700 C SKIP(JN=+1) IF NOT COMING FROM 'EDIT'
08100 MOVEM 02,JN ; 03800 JN=1
08200 MOVEI 15,1 ; 03900 DO 702 K=1,4
08300 ;;S702: CAMN N,SCN -1(15) ;4000 702 IF(N.EQ.LRUD(K))GO TO 703
08400 ;; JRST S703
08500 ;!!!! 1/78 CAIGE 15,4
08600 ;; CAIGE 15,4 **************************
08700 ;; AOJA 15,S702 ; 04100 C FINDS L, R, U, D
08800 S702: CAMN N,LRUD -1(15) ;4000 702 IF(N.EQ.LRUD(K))GO TO 703
08900 JRST S703
09000 CAIGE 15,4
09100 AOJA 15,S702 ; 04100 C FINDS L, R, U, D
09200 ;;;; CAMN N,A2Z+=11 ; L?
09300 ;;;; JRST S703
09400 ;;;; AOS 15
09500 ;;;; CAMN N,A2Z+=17 ; R?
09600 ;;;; JRST S703
09700 ;;;; AOS 15
09800 ;;;; CAMN N,A2Z+=20 ; U?
09900 ;;;; JRST S703
10000 ;;;; AOS 15
10100 ;;;; CAMN N,A2Z+=3 ; D?
10200 ;;;; JRST S703
10300 CAMLE N,LBL ;GO TO S703 IF REALLY A LETTER, ELSE MOVE UP POINTER
10400 JRST S899 ;****** 1/78
10500 S703: AOS JJ ; 703 JJ=JJ+1 04200 YOU CAN TYPE THE FULL WORD
10600 MOVE K,15 ; 04400 IF(K.NE.4)GO TO 77
10700 CAIE K,4
10800 JRST S77 ; 04450 IF(INP(ML).EQ.'E')K=99
10900 MOVE 2,LE
11000 CAMN 2,INP-1(ML)
11100 MOVEI K,=99 ; 04500 C 'DE'=DELETE
11200 S77: CAMN N,LE ; 04600 77 IF(N.EQ.'E')K=55
11300 MOVEI K,=55 ; 04700 C 'E'= EDIT
11400 CAMN N,LC ; 04800 IF(N.EQ.'C')K=2222
11500 MOVEI K,=2222 ; COPY 04900 IF(N.EQ.IXX)K=222
11600 CAMN N,IXX ; EXIT
11700 MOVEI K,=222 ;05000 C 'C'=COPY, 'X'=EXIT FROM EDIT MODE
11800 FLTR K,K ; 05100 VX(JJ)=K
11900 MOVEM K,VX-1(JJ) ;05200 704 IF(INP(ML).EQ.IBLA)GO TO 2799
12000 S704: SKIPL INP-1(ML) ;IF(INP(ML).GT.0)GO TO 2799
12100 JRST S2799 ; IF NEXT CHAR. IS A LETTER(NEG.), SKIP IT.
12200 ; 05300 C PUT COMMA ERASER IN SCX.
12300 AOJA ML,S704 ;05400 ML=ML+1
12400 ; 05500 C SO IT WILL SKIP 'D' AND 'EL' IN 'EDIT' AND 'DEL'
12500 ; GO TO 704
12600 S173: JSA 16,NALF ; 05700 173 K=NALF(N)
12700 JUMP N ; 0 IS K
12800 JUMPG N,S1410 ;05800 IF(N.GT.0)GO TO 1410
12900 CAIN =18 ;5810 --R-- IF(K.EQ.18)GO TO 73
13000 JRST S73
13100 MOVEI 02,2 ; 05815 C JUMP IF A REST OR OTHER R'S
13200 CAMN 02,MODE ; 05820 IF(MODE.EQ.2)GO TO 144
13300 JRST S144
13400 ;YOU CAN TYPE 'S', ETC., FOR SIXTEENTH ETC., RHYTHM.
13500 ; JUMP IF NOT A LETTER
13600
13700 ; notes = 1xyz.0 x=accidental, yz=note num., negative=chord note
13800 ; rest = 2xyz.0 z=0=ordinary, =1=invis., =2=whole, =3=repeat bar
13900 ; =4=down, =5=up, -2xyz=num. of meas. rest
14000 ; clefs = 3xyz.0 z=0=treble, =1=bass, =2=alto, =3=tenor, neg.=invis.
14022 ; use TRE,BAS,ALT,TEN for clefs with no change to note levels.(4,5,6,7)
14100 ; bars = 4xyz.0 z=num. of staves up, neg.=dbl.bar
14200 ; ksig = 17xyz.0 z=num. of accis., pos.=#, neg.=b, x=1 for naturals.
14300 ; meter = 18xyz.n xy=top num, zn=bottom num (DONE IN SCMSS)
14400 ; stem = 5xyz.0 YZ=10=stem up, =20=stem down
14500 ; staff = 5xyz.0 z=0=return to norm., =1=lower stf., =2=upper stf.
14600
14700 CAIGE =8 ;6100 --H-- IF(K.LT.8)GO TO 15
14800 JRST S15 ;06200 C JUMP IF A POSSIBLE NOTE
14900 CAIE =11 ;6300 --K-- IF(K.NE.11)GO TO 16
15000 JRST S16 ;06400 C JUMP IF NOT A KSIG
15100 MOVE QQ,[17000.0] ;QQ=17000 **** KEY SIGS ***
15200 S18: MOVE N,INP-1(ML) ;6500 18 N=INP(ML)
15300 AOS ML ; 06600 ML=ML+1
15400 CAMN N,LBL ;IF(N.EQ.IBLA)GO TO 18
15500 JRST S18
15600 ;; CAME N,[ASCIZ/N /] ; IS IT AN N? K3FN/ OR K2SN/ MAKES NATURALS
15700 CAME N,LN ; IS IT AN N? K3FN/ OR K2SN/ MAKES NATURALS
15800 JRST S200 ;IF NEXT CHAR='N' A 'NATURALS' KEY SIG.
15900 MOVE 2,[100.0]
16000 SKIPG QQ
16100 MOVNS 2
16200 FADR QQ,2
16300 JRST S18
16400 S200: CAME N,LS ; 06750 IF(N.EQ.'S')GO TO 18
16500 CAMN N,LPL ; 06775 IF(N.EQ.'+')GO TO 18
16600 JRST S18 ; 06800 IF(N.EQ.ISEMI)GO TO 20
16700 CAMN N,ISEMI
16800 JRST S20 ; 06900 IF(N.EQ.'-')N='F'
16900 CAMN N,LMI
17000 JRST .+3 ;6950 IF(N.NE.'F')GO TO 18
17100 CAME N,LF
17200 JRST S19 ; 07200 19 A=NALF(N)
17300 MOVNS QQ ;NEG. FOR FLATS
17400 JRST S18 ;GO BACK AND LOOK AGAIN
17500 S19: JSA 16,NALF
17600 JUMP N
17700 FLTR K,K ;TLC K,232000
17800 JRST S18
17900 S20: JUMPL QQ,.+3
18000 FADR QQ,K
18100 SKIPA
18200 FSBR QQ,K ;07400 20 VX(1)=(17000.+A)*XMINUS
18300 MOVEM QQ,VX ;07500 KSIG
18400 JRST SEND ; 07600 RETURN
18500 S16: CAIE =9 ;-- I -- 7700 16 IF(K.NE.9)GO TO 2
18600 JRST S2
18700 MOVSI 02,205540 ; 07800 VX(1)=22.
18800 MOVEM 02,VX ; 07900 C FOR EDIT I21 ETC.
18900 JRST S2799 ;8000 GO TO 2799
19000 S2: CAIE =13 ; -- M -- 08100 2 IF(K.NE.13)GO TO 3
19100 JRST S3 ;8200 C JUMP IF NOT A MEASURE LINE
19200 ;; MOVSI 02,214764 ; ***** BARS =4000 ******
19300 MOVE 2,[4001.0] ; THE 1 IS FOR BAR ONE STAFF ONLY.
19400 MM: MOVE 1,INP -1(ML) ;08310 MM: JN=INP(ML)
19500 MOVEM 1,JN
19600 ;; CAME 1,LD ; 08320 IF(JN.NE.LD)GO TO 23
19700 CAMN 1,LD ; IF (JN.EQ.LD)GO TO MD ;; JRST S23
19800 JRST MD
19900 CAME 1,[-=27245141952] ;IF (JN.NE.'M')GO TO 23
20000 JRST S23
20100 FADR 2,[1.0] ;VX(1)=VX(1)+1 GO TO MM
20200 AOJA ML,MM ; GO BACK AND LOOK FOR MORE M'S ML=ML+1
20300 MD: AOS ML ;8330 ML=ML+1
20400 ; FOUND 'MDN' -- FOR DOUBLE BARS
20500 SETZM JN ;8350 JN=0
20600 MOVNS 02 ;DBL BARS ARE NEG.
20700 S23: MOVEM 02,VX
20800 JSA 16,NALF
20900 JUMP INP-1(ML) ;8400 23 K=NALF(INP(ML))
21000 JUMPLE K,S512 ; 08500 IF(K.LE.0)GO TO 512
21100 CAILE =9 ; 08505 IF(K.GT.9)GO TO 512
21200 JRST S512 ;NO MORE THAN 8 STAVES UP ALLOWED.
21300 SOJ K, ;K=K-1 BECAUSE ORIG. NUM WAS 4001, NOT 4000
21400 SKIPN JN ;8510 OLD CODE HERE! IF(JN.EQ.0)K=K+10
21500 MOVNS K ;NEG. IF DBL BAR
21600 FLTR K,K
21700 FADRM K,VX ;08600 C 'M2'= A BAR LINE UP 2 STAVES. ETC.
21800 JRST S512 ; 08700 GO TO 512
21900 S3: CAILE =16 ;-- P -- 08800 3 IF(K.GT.16)GO TO 4
22000 JRST S4 ; 08900 C JUMP IF NOT FOR 'PROXIMITY' MODE
22100 SUBI =15 ; 09000 NSWCH=K-15
22200 MOVEM K,NSWCH#
22300 JRST S2799 ; 09100 GO TO 2799
22400 ; TO SWITCH ALWAYS USE OCT.# /PBF4/ /OE5/ P=PROXIMITY, O=ORDINARY
22500 S4: CAIE =20 ; 09500 4 IF(K.NE.20)GO TO 21
22600 JRST S21 ; 09600 C TRY AGAIN IF NOT A 'T'
22700 MOVE 3,INP -1(ML) ;09700 IF(INP(ML).GT.0)GO TO 2799
22800 JUMPG 3,S2799;T12,8/ ETC. MAKES A METR, OR TIM SIG. POS NUMS AREN'T LETRS!
22900 MOVSI 02,214567 ; ***** CLEFS = 3000 ***** CODE 3.
23000 CAMN 3,LE
23100 FADR 2,[3.0] ; TENOR CLEF =3003, TREBLE=3000
23200 JRST SCLEF ; 10100 GO TO SCLEF
23300 S21: CAIE =19 ; -- S -- 10200 21 IF(K.NE.19)GO TO 899
23400 JRST S2799 ;NOT AN 'S'(STEM), UNKNOWN ITEM, SKIP IT.
23500 MOVE 2,INP-1(ML) ;10600 IF(INP(ML).EQ.LDN)VX(1)=5020.
23600 MOVE 03,[5000.0] ; SU UP=5010
23700 CAMN 2,LU
23800 FADR 3,[10.0]
23900 CAMN 2,LD
24000 FADR 3,[20.0] ; DOWN = 5020
24100 CAMN 2,LPL ;IF( .EQ.'+') S+=5002
24200 FADR 3,[2.0]
24300 CAMN 2,LMI ;IF( .EQ.'-') S-=5001
24400 FADR 3,[1.0] ; IF( .EQ.'0') S0=5000
24500 ;THESE ARE FOR S+, S-, S0; PUT NOTE ON OTHER STF.
24600 MOVEM 03,VX
24700 JRST S512 ; 10700 GO TO 512
24800 S15: MOVE N,INP -1(ML) ; 11100 N=INP(ML)
24900 CAIN K,2 ;IF(1ST LETR.NE.'B')GO TO S5
25000 CAME N,LA ; 11200 IF(N.NE.'A')GO TO 5
25100 JRST S5 ; 11300 C JUMP IF NOT BASS CLEF
25200 MOVE 02,[3001.0] ;BASS CLEF=3001
25202 SCLEF: MOVE N,INP(ML) ;N=INP(ML+1) GET 3RD CHAR.
25204 CAMN N,LBL ;IF(N.EQ.' '.OR.N.EQ.'/'.OR.N.EQ.';')GO TO SCLF
25206 JRST SCLF ;IF 3RD CHAR IS SIGNIFICANT THEN SPECIAL CLEF
25208 CAME N,LSL ; 4,5,6,7 = 0,1,2,3 BUT NO INFLUENCE ON NOTE LEVEL
25210 CAMN N,ISEMI
25212 JRST SCLF
25214 FADR 2,[4.0]
25216 AOS ML ;ML=ML+1
25300 SCLF: MOVEM 02,VX
25400 SKIPGE XMINUS ; 11500 51 IF(XMINUS)VX(1)=-VX(1)
25500 MOVNS VX ;11600 TYPE '-BA' FOR INVISIBLE BASS CLEF, ETC.
25600 JRST S512
25700 S5: CAME N,LL ; 11800 5 IF(N.NE.'L')GO TO 6
25800 JRST S6 ; 11900 JUMP IF NOT ALTO CLEF
25900 MOVE 02,[3002.0]
26000 JRST SCLEF
26100 S6: SUBI 2 ; -2 BECAUSE MUSICAL ALPHABET STARTS WITH C
26200 SKIPG
26300 ADDI 7
26400 MOVE NNUM,K ; K IS AC0
26500 MOVEI QQ,=1000
26600 MOVEI K,1 ;6 K=1
26700 CAILE NNUM,3 ; 12300 IF(NNUM.GT.3)K=2
26800 AOJ K, ;12500 C FOUND A NOTE
26900 CAMN N,IXX ; 12700 IF(N.EQ.IXX)GO TO 5410
27000 JRST S5410 ; 12800 C FOR GX3/ ETC.
27100
27200 CAME N,INP-2(ML) ;IF(N.NE.INP(ML))GO TO SS6
27300 JRST SS6 ; NO DOUBLE-LETTER ACCID. (FLAT)
27400 CAME N,INP(ML) ;IF(N.NE.INP(ML+1))GO TO S8-2
27500 JRST S8-2 ;NO TRIPLE-LETTER ACCID. (SHARP)
27600 AOS ML ;ML=ML+1
27700 CAME N,INP(ML) ;IF(N.NE.INP(ML+1))GO TO S8
27800 JRST S8 ;NO TRIPLE-LETTER ACCID. (NATURAL)
27900 AOS ML ;ML=ML+1
28000 MOVEI QQ,=1300 ;TYPE AA FOR AF, AAA = AS, AAAA = AN
28100 JRST S610
28200
28300 SS6: JSA 16,NALF ; 12900 K=NALF(N)
28400 JUMP N
28500 JUMPG N,S7 ;13000 IF(N.GT.0)GO TO 7
28600 ;13100 C JUMP IF NOT A LETTER
28700 MOVEI QQ,=1300 ; ***** NOTES ***** =1000 2ND DIG=ACCI.
28800 CAIE =22 ;*** CAN USE 'V' FOR NATURAL(EASIER TO HIT!!)
28900 CAIN =14 ; --N-- = 13300 IF(K.EQ.14)GO TO 610
29000 JRST S610 ; 13500 C JUMP IF NATURAL
29100 CAIN =19 ; -- S -- = 13400 IF(K.EQ.19)GO TO 8
29200 JRST S8
29300 MOVEI QQ,=1100 ; IT'S A FLAT
29400 JRST S610
29500 S8: MOVEI QQ,=1200 ; SHARP =1200
29600 S610: AOS ML ; 14100 610 ML=ML+1
29700 JSA 16,NALF ;14200 K=NALF(INP(ML))
29800 JUMP INP-1(ML)
29900 SKIPL INP-1(ML) ;IF CHAR. ISN'T A LETTER, GO TO S7
30000 JRST S7 ; (LETTERS ARE NEG., NUMBS ARE POS.)
30100 CAIE =19 ;IF(K.EQ.19) THEN IT'S SS
30200 JRST .+3 ;FOR DBL FLAT, DBL SHARP
30300 MOVEI QQ,=1500 ;DBL FLAT
30400 JRST S610
30500 CAIE 6 ;IS IT 'FF'?
30600 JRST S7
30700 MOVEI QQ,=1400 ;FF=1400, SS=1500
30800 JRST S610 ; GO BACK FOR ANOTHER CHAR.
30900 S7: CAIN =11 ;-- K -- ??? 14300 7 IF(K.EQ.11)GO TO 5410
31000 JRST S5410
31100 JUMPL K,S5410 ; 14350 IF(K.LT.0)GO TO 5410
31200 ;14400 C JUMP IF SEMICOLON OR BLANK
31300 CAIN =24 ;-- X --14500 IF(K.NE.24)GO TO 24
31400 JRST S5410 ; 14800 24 JSCA=K-1
31500 S24: MOVEM K,JSCA# ; SAVE OCT. NUM
31600 AOS ML ; 14900 ML=ML+1
31700 JRST S2410
31800 S5410: SKIPN NSWCH ;15300 5410 IF(NSWCH.EQ.0)GO TO 2410
31900 JRST S2410
32000 MOVN JJ,NNUM ; 15910 7410 JJ=NOLD-NNUM
32100 ADD JJ,NOLD
32200 CAIL JJ,4 ; 15920 IF(JJ.LT.4)GO TO 377
32300 AOS JSCA
32400 CAMG JJ,[-4] ; 16010 377 IF(JJ.GT.-4)GO TO 2410
32500 SOS JSCA
32600 ;WILL JUMP TO NEAREST NOTE (DIATONIC-'75)
32700 S2410: MOVEI JJ,1 ; 16200 2410 JJ=1
32800 SETZM VX+1 ; 16300 VX2=0
32900 MOVE 2,JSCA ;VX1=(1000+ACCI*100+OCT*7+NNUM)*DBST
33000 IMULI 2,7
33100 ADD 2,NNUM
33200 ADD 2,QQ ; ADD 1000+OCT*7 (QQ)
33300 FLTR 2,2
33400 FMPR 2,DBST
33500 MOVEM 2,VX ; 16500 C DOUBLE STOPS ARE NEG. NUMBERS
33600 MOVEM NNUM,NOLD# ; 16600 NOLD=NNUM
33700 ;; ?S4410: MOVNI NNUM,2 ;16700 4410 NNUM=-2
33800 S4410: MOVE 02,ISEMI ;16800 IF(INP(ML).EQ.ISEMI)RETURN
33900 CAMN 02,INP -1(ML)
34000 JRST SEND
34100 ;ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
34200 JRST S310
34300 S210: AOS JJ ; 17100 210 JJ=JJ+1
34400 CAIN JJ,1 ; 17200 IF(JJ.EQ.1)GO TO 3310
34500 JRST S3310
34600 MOVSI XMINUS,201400 ; 17300 XMINUS=1.
34700 SETZM VX -1(JJ) ; 17400 VX(JJ)=0
34800 ; 'X N1,N2' MAY REPLACE 'REP N1,N2'. N2=0 BECOMES N2=2
34900 JRST S310 ; 17800 C JUMP IF A LETTER
35000 S1410: MOVE MODE ; 17900 1410 IF(N.NE.'-')GO TO 14
35100 CAME N,LMI
35200 JRST S544
35300 MOVN XMINUS,[1.0] ; 18000 XMINUS=-1.
35400 JUMPE JJ,S2799 ; IF(JJ.EQ.0)GO TO 2799 -- FOR '-BA' ETC.
35500 CAIN 1
35600 JRST S644 ; IF(MODE.EQ.1)GO TO 644 [FOR AUTO OCT. SYS.]
35700 JRST S2799 ; 18100 GO TO 2799
35800 S544: CAIN 1 ; IF(N.NE.'+')GO TO 14
35900 CAME N,LPL
36000 JRST S14
36100 S644: MOVSI 7,203700 ; [7.0] DEFAULT IS OCTAVE. (+ OR - 7)
36200 JSA 16,NALF
36300 JUMP ALF-1(ML) ;THE NEXT CHARACTER.
36400 CAIG =9
36500 SKIPG
36600 JRST S744 ;NEXT IS NOT A NUMB.
36700 FLTR 7,0 ;MOVE 7,0
36800 AOJ ML,
36900 S744: CAME N,LPL
37000 MOVNS 7
37100 MOVEM 7,VX4 ; SEND IT TO SCMSS -- AT 71
37200 JRST S2799
37300
37400 ; 18102 144 TRIP=0
37500 S144: SETZM TRIP
37600 ; 18105 444 IF(K.EQ.8)VX1=2
37700 S444: CAIE =8
37800 JRST .+3
37900 MOVSI 2,202400
38000 JRST SVX
38100 CAIE 4 ;18107 IF(K.EQ.4)VX1=.5
38200 JRST .+3
38300 MOVSI 2,200400
38400 JRST SVX
38500 CAIE 5 ; 18110 IF(K.EQ.5)VX1=8
38600 JRST .+3
38700 MOVSI 02,204400
38800 JRST SVX
38900 CAIE 7 ; 18115 IF(K.EQ.7)VX1=88
39000 JRST .+3
39100 MOVSI 02,207540
39200 JRST SVX
39300 CAIE =19 ; 18120 IF(K.EQ.19)VX1=16
39400 JRST .+3
39500 MOVSI 02,205400
39600 JRST SVX
39700 CAIE =20 ; 18125 IF(K.NE.20)GO TO 244
39800 JRST S244
39900 MOVSI 02,204600 ; 18126 VX1=12
40000 MOVE N,INP -1(ML) ; 18127 N=INP(ML)
40100 CAME N,LBL ; 18129 IF(N.EQ.LBL)GO TO 344
40200 CAMN N,ISEMI
40300 ;; JRST S344 ; 18131 IF(N.EQ.ISEMI)GO TO 344
40400 JRST SVX
40500 CAIE N,1 ;IF(N.EQ.1)GO TO SVX (DOT WAS CHANGED TO 1)
40600 CAMN N,IXX ; IF(N.EQ.IXX)GO TO SVX
40700 JRST SVX
40800 MOVSI TRIP,576400 ; 18133 TRIP=-1
40900 AOS ML ; 18150 ML=ML+1
41000 JSA 16,NALF ; 18155 K=NALF(N)
41100 JUMP N
41200 MOVE N,INP-1(ML) ; N=INP(ML) *******
41300 JRST S444 ; 18160 GO TO 444
41400 S244: CAIE =23 ; 18220 244 IF(K.EQ.23)VX1=1
41500 JRST .+3
41600 MOVSI 02,201400
41700 JRST .+4
41800 CAIE =17 ; 18222 IF(K.EQ.17)VX1=4
41900 JRST .+3
42000 MOVSI 02,203400
42100 SVX: MOVEM 02,VX ; 18223 C TS=24TH, TQ=6, TH=3.
42200 ; FOR S,E,Q,H,W,D,T RHYTH. 'T'(K=20) =TRIPLET D=DBL WHL NOTE
42300 JUMPGE TRIP,S344 ;18225 IF(TRIP)VX1=VX1*1.5
42400 MOVSI 2,201600
42500 FMPRM 02,VX
42600 S344: AOS JJ ; 18226 344 JJ=JJ+1
42700 JRST S1310
42800
42900 S14: SETOM ISKP ; 18230 14 ISKP=-1
43000 CAME N,DOT ; 18300 IF(N.NE.'.')GO TO 79
43100 JRST S79
43200 MOVE DECI,M ; 18400 DECI=M
43300 JRST S75
43400 S79: AOS M ; 18600 79 M=M+1
43500 JSA 16,NALF ;18700 IQ(M)=NALF(N)
43600 JUMP N
43700 MOVEM 00,IQ -1(M)
43800
43900 S75: CAMN N,ISEMI ;18900 75 IF(N.EQ.ISEMI)GO TO 751
44000 JRST S751
44100 MOVEI 02,1 ; 18950 IF(INP(ML).NE.1)GO TO 2799
44200 CAME 02,INP -1(ML)
44300 JRST S2799
44400 S751: JUMPE ISKP,SEND ; 19000 751 IF(ISKP.EQ.0)RETURN
44500 S202: CAME DECI,[-1] ; 19100 202 IF(DECI.NE.-1)GO TO 302
44600 JRST S302
44700
44800 SETZM DECI ; 19200 DECI=0
44900
45000 JRST S402
45100
45200 S302: SUB DECI,M ; 19400 302 DECI=M-DECI
45300 MOVNS DECI ; 19500 402 RRN=0
45400 S402: SETZM RRN# ; 19600 REXP=M-1
45500 MOVNI 02,1
45600 ADD 02,M
45700 FLTR 2,2 ;TLC 2,232000
45800 ;; FADR 2,2
45900 MOVEM 2,REXP ; 19700 IF(M.LT.1)M=1
46000 CAIGE M,1
46100 MOVEI M,1 ; 19800 DO 171 K=1,M
46200 MOVEI QQ,1 ;USE QQ FOR INDEX
46300 ; 19900 IF(REXP.GT.1)GO TO 1
46400 S171: MOVSI 02,201400
46500 CAMGE 02,REXP
46600 JRST S1 ; 20000 RRV=10
46700 MOVSI 02,204500 ; RRV IS IN 2
46800 SKIPN REXP ; 20100 IF(REXP.EQ.0)RRV=1
46900 MOVSI 02,201400
47000 JRST S11 ; 20300 1 RRV=10.**REXP
47100 S1: MOVSI 02,204500
47200 MOVE 03,REXP
47300 PUSHJ 17,EXP3.2 ;20400 11 RRN=RRN+IQ(K)*RRV
47400 S11: FLTR 3,IQ-1(QQ) ;MOVE 3,IQ-1(QQ)
47500 FMPR 2,3
47600 FADRM 2,RRN ; 20500 171 REXP=REXP-1
47700 MOVSI 02,576400
47800 FADRM 02,REXP
47900 CAMGE QQ,M
48000 AOJA QQ,S171
48100 JUMPE DECI,.+6
48200 FLTR DECI,DECI ;TLC DECI,232000
48300 MOVSI 02,204500 ; 20600 A=10.**DECI
48400 MOVE 03,DECI
48500 PUSHJ 17,EXP3.2 ; A WILL BE IN AC2
48600 SKIPA ; 20700 IF(DECI.EQ.0)A=1.
48700 MOVSI 02,201400 ; 20800 JJ=JJ+1
48800 AOS JJ ; 20900 VX(JJ)=RRN/A*XMINUS
48900 MOVE 1,RRN
49000 FDVR 1,2
49100 FMPR 1,XMINUS
49200 MOVEM 1,VX -1(JJ) ; 21000 JN=-JN
49300 MOVNS 00,JN ;21100 C SETS IT TO -1 FOR L,R,U,D EDIT ROUTINE
49400 MOVEI 02,2 ; 21200 IF(MODE.NE.2)XMINUS=1.
49500 CAME 02,MODE
49600 MOVMS XMINUS ; 21300 C************: MODE #?
49700 ; 21400 C ONLY ONE - NEEDED FOR RHY.COMPOSITE
49800 S1310: MOVEI 3,1 ; 21500 1310 IF(INP(ML).NE.1)GO TO 310
49900 CAME 3,INP -1(ML)
50000 JRST S310 ;21600 VX(JJ+1)=VX(JJ)*2. ; FOR DOTTED RHYTHMS
50100 ;; MOVE 02,VX -1(JJ)
50200 ;; FSC 02,1
50300 ;; MOVEM 02,VX (JJ) ; 21700 JJ=JJ+1
50400 ;; AOS JJ ; 21800 ML=ML+1
50500 MOVE 2,[1000.0] ;VX(JJ)=VX(JJ)+1000
50600 FADRM 2,VX-1(JJ) ;1000 IS ADDED FOR EACH DOT. NO MORE COMPOSITES!!
50700 AOS ML
50800 JRST S1310 +1 ; 22000 206 ML=ML+2
50900 S206: ADDI ML,2 ; 22100 3310 VX(1)=-99.
51000 S3310: MOVN 02,[99.0]
51100 MOVEM 02,VX ; 22200 310 ISKP=0
51200 S310: SETZM ISKP ; 22300 IF(N.NE.ISEMI)GO TO 999
51300 CAME N,ISEMI
51400 JRST S999 ; 22500 RETURN
51500 SEND: MOVEM ML,ALF+=72
51600 MOVEM JJ,SC+=9
51700 JRA 16,(16) ; 22600 73 JJ=JJ+1
51800 S73: AOS JJ ; 22650 K=INP(ML)
51900 MOVE K,INP -1(ML) ;22700 IF(K.EQ.'E')GO TO 206
52000 CAMN K,LE
52100 JRST S206 ; NEXT IS FOR A REST/R/ OR /RI/ FOR INVIS. REST
52200 CAMN K,LD ; 22810 IF(K.EQ.'D')GO TO 1073
52300 JRST S1073
52400 ; /RD/ OR /RU/ = REST 6 DOWN OR 6 UP.
52500 CAMN K,LU ; 22830 IF(K.EQ.'U')GO TO 1173
52600 JRST S1173 ; 22900 IF(K.EQ.'I')GO TO 573
52700 CAMN K,LI
52800 JRST S573 ; 22910 IF(K.EQ.'W')GO TO 273
52900 CAMN K,LW
53000 JRST S273
53100 ; /RW/ MAKES WHOLE REST REGARDLESS OF TIME VALUE GIVEN.
53200 CAMN K,LR ;IF(K.EQ.'R')GO TO 1273
53300 JRST S1273 ; /RR/ MAKES REPEAT BAR SIGN (REST=-4)
53400
53500 ; *** ADD NUMBERS LATER *****; 22932 K=NALF(K)
53600 JSA 16,NALF
53700 JUMP K ; 22934 IF(K)GO TO 673
53800 JUMPL K,S673 ; 22936 IF(K.GE.10)GO TO 673
53900 CAIL =10
54000 JRST S673 ; 22940 973 KV=NALF(INP(ML+1))
54100 S973: MOVE 15,K
54200 JSA 16,NALF
54300 JUMP INP(ML)
54400 ; FOR 3-DIG. NUMBS. CAN TAKE NUM UP TO 999 FOR RESTS.
54500 ; 22942 IF(KV)GO TO 873
54600 JUMPL S873 ;22944 IF(KV.GE.10)GO TO 873
54700 CAIL =10
54800 JRST S873 ; 22945 ML=ML+1
54900 AOS ML ; 22946 K=K*10+KV
55000 IMULI 15,=10
55100 IMUL 02,K
55200 ADD 15,K ; 15 IS K FOR NOW AND K IS IV
55300 JRST S973+1
55400
55500 S873: ADDI 15,=2000 ; QQ IS AC15 NOW. RW =2002
55600 MOVNS 15
55700 FLTR 15,15 ;TLC 15,232000
55800 JRST S473
55900 S673: MOVSI 15,213764 ;QQ=2000
56000 JRST S373 ;ORDINARY REST
56100 S573: MOVE 15,[2001.0] ;INVISIBLE REST
56200 JRST S473
56300 S273: MOVE 15,[2002.0] ;WHOLE REST (NO MATTER WHAT RHYTH.]
56400 S473: AOS ML ; 22990 473 ML=ML+1
56500 S373: MOVEM 15,VX-1(JJ) ; 23000 373 VX(JJ)=QQ
56600 JRST S4410
56700 S1073: MOVSI 15,213765 ;RD = REST DONW 2004
56800 JRST S473
56900 S1173: MOVE 15,[2005.0] ;RU = REST UP 2005
57000 JRST S473
57100 S1273: MOVE 15,[2003.0] ;RR = BAR REPEAT SIGN
57200 JRST S473 ; FOR /RR/
57300 ;23400 END
57400 LNEND: 0 ;SEE FORTR. TEXT IN WORDS.F4
57500 MOVE 0,LST ; * SCX+7
57600 MOVE 1,SCX+=9 ; ;
57700 ;; MOVE 2,SCN+4 ; /
57800 MOVE 2,LSL ; /
57900 SETZ 3, ;AC3=0
58000 MOVEI 5,=71
58100 ;;; MOVEI 3,=71
58200 L2901: CAME 2,ALF(3)
58300 JRST L2903
58400 MOVE 4,3 ;AC4=AC3
58500 ;;; MOVEM 1,ALF(3)
58600 JRST L2902 ;GO TO L2902
58700 ;;; JRA 16,(16)
58800 L2903: CAME 1,ALF(3)
58900 JRST L2902
59000 MOVEM 0,ALF(3)
59100 JRA 16,(16)
59200 ;;;L2902: SKIPLE 3
59300 L2902: AOJ 3,
59400 CAMG 3,5
59500 JRST L2901
59600 MOVEM 1,ALF(4) ;GET LOC. OF LAST /
59700 ;;; SOJA 3,L2901
59800 JRA 16,(16)
59900
60000 STFNUM: 0 ;FUNCTION STFNUM(STAFF)
60100 SETOM SCXNR# ;SCXNR=-1 FLAG
60200 SETZ 6,
60300 STFN1: MOVE 2,INP(6)
60400 MOVE 4,INP+1(6)
60500 CAME 2,LS ;IS INP1='S'?
60600 JRST NONUM
60700 CAME 4,LTT ; IF(INP(2).EQ.'T')STAFF=NEXT NUM
60800 CAMN 4,LP ; IS IT A P?
60900 ;; CAME 4,[ASCIZ/T /] ; IF(INP(2).EQ.'T')STAFF=NEXT NUM
61000 ;; CAMN 4,[ASCIZ/P /] ; IS IT A P?
61100 SKIPA
61200 JRST NONUM ;NO
61300 MOVE 3,LZ ;PUT Z'S INTO FIRST LOCS.
61400 ;; MOVE 3,[ASCIZ/Z /] ;PUT Z'S INTO FIRST LOCS.
61500 MOVE ML,6 ;ML=3+PTR
61600 ADDI ML,3
61700 MOVSI XMINUS,201400
61800 MOVE 2,INP+2(6) ;LOOK AT 3RD CHAR.
61900 CAME 2,LMI ;IS IT MINUS?
62000 JRST .+3
62100 MOVNS XMINUS
62200 AOJ ML, ;ML=ML+1
62300 JSA 16,NALF ;GET THE STAFF NUM.
62400 JUMP INP-1(ML)
62500 FLTR
62600 FMPR XMINUS
62700 CAME 4,LP ;IF NOT 'P' GO TO STFN2
62800 ;; CAME 4,[ASCIZ/P /] ;IF NOT 'P' GO TO STFN2
62900 JRST STFN2
63000 SETOM SCX+=30 ;RB=-1
63100 MOVEM RMOD+1 ;SET4 IS NOW FILLED
63200 JRST STFN3-1
63300 STFN2: SETZM SCX+=30 ;RB=0
63400 MOVEM @(16) ;TYPE STn/ TO SET STAFF NUM FOR ENTIRE LINE.
63500 MOVE ML,6
63600 STFN3: MOVE 2,INP(ML) ;LOOK FOR THE SLASH AND THROW ALL AWAY
63700 MOVEM 3,INP(ML) ;SKIP UNTIL SEMI (CHANGED FROM SLASH AT S899)
63800 AOJ ML,
63900 CAME 2,LSL
64000 JRST STFN3
64100 SETZM SCXNR ;RETURN A ZERO
64200 MOVE 6,ML
64300 JRST STFN1 ;GO BACK AND LOOK FOR MORE.
64400 NONUM: MOVE SCXNR ;NO STAFF NUM, RETURN A -1
64500 JRA 16,1(16)
64600
64700 RLOOP: 0 ;CALL RLOOP(A,B,K)
64800 HRLI 1,@1(16) ;DIMENSION A(1),B(1) -- SOURCE
64900 HRRI 1,@(16) ;DO 1 J=1,K -- DESTINATION
65000 MOVE 2,(16) ;1 A(J)=B(J) -- WORD COUNT
65100 ADD 2,@2(16) ;LOC OF ARRAY A + WDCNT.
65200 BLT 1,-1(2)
65300 JRA 16,3(16)
65400 END